home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / RunTime Sk200605252001.psc / ModGP.bas < prev    next >
Encoding:
BASIC Source File  |  2001-05-08  |  13.4 KB  |  345 lines

  1. Attribute VB_Name = "ModGP"
  2. Global Curtool As Integer
  3. Global FBcancel As Boolean
  4. Global BWcancel As Boolean
  5. Global RScancel As Boolean
  6. Global CWcancel As Boolean
  7. Global saveCancel As Boolean
  8. Global RulersVis As Boolean
  9. Global finalclose As Boolean
  10. Global Newcancel As Boolean
  11. Global NewHeight As Long
  12. Global NewWidth As Long
  13. Global NewBGcol As Long
  14. Global CurBGindex As Integer
  15. Global curfilter As Integer
  16. Global curfilterlevel As Integer
  17. Global curborder As Integer
  18. Global curborderlevel2 As Integer
  19. Global curborderlevel3 As Integer
  20. Global borderwidth As Integer
  21. Global framewidth As Integer
  22. Global chBGcolor As Long
  23. Global outline As Boolean
  24. Global inline As Boolean
  25. Global AspectRatio As Double
  26. Global NewScaleHeight As Long
  27. Global NewScaleWidth As Long
  28. Global Savepath As String
  29. Global curfile As String
  30. Global ReadLong As Boolean
  31. Global ReadHex As Boolean
  32. Global ReadRgb As Boolean
  33. Global maxcolchose As Integer
  34. Global colslocked As Boolean
  35. Global pastingasnew As Boolean
  36. Global startVSval As Double
  37. Global startHSval As Double
  38. Global freeselection As Boolean
  39. Global dontusePicBU As Boolean
  40. Global Masterpasting As Boolean
  41. Global sfilename As String
  42. Global Cachesize As Long
  43. Public safesavename As String
  44. Private Type POINTAPI
  45.     x As Long
  46.     y As Long
  47. End Type
  48. Public Declare Function SetWindowRgn Lib "user32" (ByVal Hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  49. Public Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal Nwidth As Long, ByVal Nheight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
  50. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  51. Public Declare Function LockWindowUpdate Lib "user32" (ByVal Hwnd As Long) As Long
  52. Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal Nwidth As Long, ByVal Nheight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  53. Public Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
  54. Public Declare Function ClientToScreen Lib "user32" (ByVal Hwnd As Long, lpPoint As POINTAPI) As Long
  55. Public Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  56. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  57. Public Declare Function ScreenToClient Lib "user32" (ByVal Hwnd As Long, lpPoint As POINTAPI) As Long
  58. Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  59. Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal Nwidth As Long, ByVal Nheight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  60. Public Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
  61. Public Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
  62. Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  63. Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  64. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  65. Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  66. Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  67. Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
  68. Declare Function BmpToJpeg Lib "BBJPeg.dll" (ByVal bmpFileName As String, ByVal JpegFilename As String, ByVal Quality As Integer) As Integer
  69. Declare Function TWAIN_AcquireToFilename Lib "EZTW32.DLL" (ByVal hwndApp%, ByVal bmpFileName$) As Integer
  70. Declare Function TWAIN_SelectImageSource Lib "EZTW32.DLL" (ByVal hwndApp&) As Long
  71. Declare Function TWAIN_AcquireToClipboard Lib "EZTW32.DLL" (ByVal hwndApp As Long, ByVal wPixTypes As Long) As Long
  72. Declare Function TWAIN_IsAvailable Lib "EZTW32.DLL" () As Long
  73. Declare Function TWAIN_EasyVersion Lib "EZTW32.DLL" () As Long
  74. Public ret As String
  75. Public Retlen As String
  76. Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  77. Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
  78.     (lpFileOp As SHFILEOPSTRUCT) As Long
  79. Private Type SHFILEOPSTRUCT
  80.     Hwnd As Long
  81.     wFunc As Long
  82.     pFrom As String
  83.     pTo As String
  84.     fFlags As Integer
  85.     fAborted As Boolean
  86.     hNameMaps As Long
  87.     sProgress As String
  88.     End Type
  89.     Private Const FO_MOVE = &H1
  90.     Private Const FO_COPY = &H2
  91.     Private Const FOF_SILENT = &H4
  92.     Private Const FOF_RENAMEONCOLLISION = &H8
  93.     Private Const FOF_NOCONFIRMATION = &H10
  94.     Private Const FOF_SIMPLEPROGRESS = &H100
  95.     Private Const FOF_ALLOWUNDO = &H40
  96.     Private Const FO_DELETE = &H3
  97.    Private Const FO_RENAME = &H4&
  98. Dim flag As Integer
  99. Dim fred As Integer
  100. Dim FOF_FLAGS As Long
  101. Dim SHFileOp As SHFILEOPSTRUCT
  102. Dim FO_FUNC As Long
  103. Global Const SWP_NOMOVE = 2
  104. Global Const SWP_NOSIZE = 1
  105. Global Const HWND_TOPMOST = -1
  106. Global Const HWND_NOTOPMOST = -2
  107. Global Const FLOAT = 1, SINK = 0
  108. Public Declare Sub SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
  109. Public Declare Function GetTempFilename Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFilename As String) As Long
  110. Public Const GWL_HWNDPARENT = (-8)
  111. Public Const SRCCOPY = &HCC0020
  112. Public Const SRCPAINT = &HEE0086
  113. Public Const SRCAND = &H8800C6
  114. Public Const SRCINVERT = &H660046
  115. Public Const FILE_ATTRIBUTE_READONLY = &H1
  116. Public ImageCount As Integer
  117. Public PenTip As Integer
  118. Public Shapetype As Integer
  119. Public PenDrawWidth As Integer
  120. Public PenTipWidth As Integer
  121. Global startwidth As Integer
  122. Global singlefactor As Double
  123. Global NoSizeonStart As Boolean
  124.  
  125.  
  126. Public Function temppath() As String
  127.     Dim sBuffer As String
  128.     Dim lRet As Long
  129.     sBuffer = String$(255, vbNullChar)
  130.     lRet = GetTempPath(255, sBuffer)
  131.     If lRet > 0 Then
  132.         sBuffer = Left$(sBuffer, lRet)
  133.     End If
  134.     temppath = sBuffer
  135.     If Right(temppath, 1) = "\" Then temppath = Left(temppath, Len(temppath) - 1)
  136. End Function
  137. 'Used to ensure a unique filename and thus
  138. 'avoid overwriting
  139. Public Function SafeSave(path As String) As String
  140. Dim mPath As String, mTemp As String, mFile As String, mExt As String, m As Integer
  141. On Error Resume Next
  142. mPath = Mid$(path, 1, InStrRev(path, "\"))
  143. mname = Mid$(path, InStrRev(path, "\") + 1)
  144. mFile = Left(Mid$(mname, 1, InStrRev(mname, ".")), Len(Mid$(mname, 1, InStrRev(mname, "."))) - 1) 'File only - no extension
  145. If mFile = "" Then mFile = mname
  146. mExt = Mid$(mname, InStrRev(mname, "."))
  147. mTemp = ""
  148. Do
  149.     If Not FileExists(mPath + mFile + mTemp + mExt) Then
  150.         SafeSave = mPath + mFile + mTemp + mExt
  151.         safesavename = mFile + mTemp + mExt
  152.         Exit Do
  153.     End If
  154.     m = m + 1
  155.     mTemp = Right(Str(m), Len(Str(m)) - 1)
  156. Loop
  157. End Function
  158. Function FileExists(ByVal fileName As String) As Integer
  159. Dim temp$, MB_OK
  160.     FileExists = True
  161. On Error Resume Next
  162.     temp$ = FileDateTime(fileName)
  163.     Select Case Err
  164.         Case 53, 76, 68
  165.             FileExists = False
  166.             Err = 0
  167.         Case Else
  168.             If Err <> 0 Then
  169.                 MsgBox "Error Number: " & Err & Chr$(10) & Chr$(13) & " " & Error, MB_OK, "Error"
  170.                 End
  171.             End If
  172.     End Select
  173. End Function
  174. Private Function PerformShellAction(sSource As String, sDestination As String) As Long
  175.       On Error Resume Next
  176.     sSource = sSource & Chr$(0) & Chr$(0)
  177.      FOF_FLAGS = BuildBrowseFlags()
  178.      With SHFileOp
  179.         .wFunc = FO_FUNC
  180.         .pFrom = sSource
  181.         .pTo = sDestination
  182.         .fFlags = FOF_FLAGS
  183.     End With
  184.     PerformShellAction = SHFileOperation(SHFileOp)
  185. End Function
  186. Public Sub RenameFile(fileName As String, Target As String)
  187.     On Error Resume Next
  188.     Dim FileStruct As SHFILEOPSTRUCT
  189.     Dim P As Boolean
  190.     Dim x As Long
  191.     Dim strNoConfirm As Integer, strNoConfirmMakeDir As Integer, strRenameOnCollision As Integer
  192.     Dim strSilent As Integer, strSimpleProgress As Integer
  193.          FileStruct.pFrom = fileName
  194.         FileStruct.pTo = Target
  195.         FileStruct.wFunc = FO_RENAME
  196.         x = SHFileOperation(FileStruct)
  197.   End Sub
  198. Private Function BuildBrowseFlags() As Long
  199.      On Error Resume Next
  200.      flag = flag Or FOF_SILENT
  201.         flag = flag Or FOF_NOCONFIRMATION
  202.    If fred = 1 Then flag = flag Or FOF_RENAMEONCOLLISION
  203.  BuildBrowseFlags = flag
  204. End Function
  205. Private Sub ShellDeleteOne(sfile As String)
  206.      On Error Resume Next
  207.    Dim FOF_FLAGS As Long
  208. Dim SHFileOp As SHFILEOPSTRUCT
  209. Dim R As Long
  210.     FOF_FLAGS = BuildBrowseFlags()
  211. sfile = sfile & Chr$(0)
  212. With SHFileOp
  213.   .wFunc = FO_DELETE
  214.   .pFrom = sfile
  215.   .fFlags = FOF_FLAGS
  216. End With
  217. R = SHFileOperation(SHFileOp)
  218. End Sub
  219. Public Sub moveme(Source As String, dest As String)
  220. FO_FUNC = 1
  221. Call PerformShellAction(Source, dest)
  222. End Sub
  223. Public Sub CopyMe(Source As String, dest As String)
  224. FO_FUNC = 2
  225. Call PerformShellAction(Source, dest)
  226. End Sub
  227. Public Sub deleteme(path As String)
  228. ShellDeleteOne (path)
  229. End Sub
  230. Public Function FileOnly(ByVal FilePath As String) As String
  231.     FileOnly = Mid$(FilePath, InStrRev(FilePath, "\") + 1)
  232. End Function
  233. Public Function ExtOnly(ByVal FilePath As String, Optional dot As Boolean) As String
  234.     ExtOnly = Mid$(FilePath, InStrRev(FilePath, ".") + 1)
  235. If dot = True Then ExtOnly = "." + ExtOnly
  236. End Function
  237. Public Function ChangeExt(ByVal FilePath As String, Optional newext As String) As String
  238. Dim temp As String
  239. temp = Mid$(FilePath, 1, InStrRev(FilePath, "."))
  240. temp = Left(temp, Len(temp) - 1)
  241. If newext <> "" Then newext = "." + newext
  242. ChangeExt = temp + newext
  243. End Function
  244. Public Function PathOnly(ByVal FilePath As String) As String
  245. Dim temp As String
  246.     temp = Mid$(FilePath, 1, InStrRev(FilePath, "\"))
  247.     If Right(temp, 1) = "\" Then temp = Left(temp, Len(temp) - 1)
  248.     PathOnly = temp
  249. End Function
  250. Public Function labeledit(Destination As String, Length As Integer) As String
  251. Dim y As Integer, m As Integer, temp As String, temp1 As String, temp2 As String, temp3 As String
  252. If Len(Destination) > Length Then
  253.     m = 0
  254.     For y = Len(Destination) To 1 Step -1
  255.         m = m + 1
  256.         If Mid(Destination, y, 1) = "\" Then
  257.             temp2 = Right(Destination, m)
  258.             Exit For
  259.         End If
  260.     Next y
  261.     m = 0
  262.     For y = 4 To Len(Destination)
  263.         m = m + 1
  264.         If Mid(Destination, y, 1) = "\" Then
  265.             temp1 = Left(Destination, m + 3)
  266.             Exit For
  267.         End If
  268.     Next y
  269.     If Len(temp1 + temp2) < Length Then
  270. doagain:
  271.     m = Len(temp1) + 1
  272.     For y = Len(temp1) + 2 To Len(Destination)
  273.         m = m + 1
  274.         If Mid(Destination, y, 1) = "\" Then
  275.             temp = Left(Destination, m)
  276.             Exit For
  277.         End If
  278.     Next y
  279.      If Len(temp + temp2) < Length Then
  280.      temp1 = temp
  281.      GoTo doagain
  282.      Else
  283.      GoTo OKdone
  284.      End If
  285.      Else
  286.      temp1 = Left(Destination, 3)
  287.      End If
  288. OKdone:
  289.         m = Length - Len(temp1 + temp2)
  290.         temp3 = "."
  291.         For y = 1 To m
  292.             temp3 = temp3 + "."
  293.         Next y
  294.     labeledit = temp1 + temp3 + temp2
  295. Else
  296.     labeledit = Destination
  297. End If
  298. End Function
  299. Public Function TrimVoid(Expre)
  300.   On Error Resume Next
  301.   Dim i As Integer
  302.   Dim beg As String
  303.   Dim expr As String
  304.   For i = 1 To Len(Expre)
  305.         beg = Mid(Expre, i, 1)
  306.         If beg Like "[a-zA-Z0-9]" Then expr = expr & beg
  307.     Next
  308.     TrimVoid = expr
  309. End Function
  310. Public Sub WriteINI(fileName As String, Section As String, Key As String, Text As String)
  311. WritePrivateProfileString Section, Key, Text, fileName
  312. End Sub
  313. Public Function ReadINI(fileName As String, Section As String, Key As String)
  314. ret = Space$(255)
  315. Retlen = GetPrivateProfileString(Section, Key, "", ret, Len(ret), fileName)
  316. ret = Left$(ret, Retlen)
  317. ReadINI = ret
  318. End Function
  319.  
  320.  
  321.  
  322. Public Function GetTempFile2(lpTempFilename As String, path As String) As Boolean
  323.     lpTempFilename = String(255, vbNullChar)
  324.     GetTempFile2 = GetTempFilename(path, "bb", 0, lpTempFilename) > 0
  325.     lpTempFilename = StripTerminator(lpTempFilename)
  326. End Function
  327.  
  328.  
  329.  
  330.  
  331. Public Function ReadText(path As String) As String
  332.     Dim Line
  333.     Dim temptxt As String
  334.     temptxt = ""
  335.     Open path For Input As #1
  336.     Do While Not EOF(1)
  337.         Input #1, Line
  338.         temptxt = temptxt + Line
  339.     Loop
  340.     Close #1
  341.     ReadText = temptxt
  342. End Function
  343.  
  344.  
  345.